home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / FIXLIB2.ZIP;1 / LIBFIX.ZIP / LIBFIX.PRG < prev   
Encoding:
Text File  |  1993-03-14  |  8.1 KB  |  309 lines
  1. * LIBFIX
  2. *   Program to replace all occurrences
  3. *       of &OLD_STR with &NEW_STR
  4.  
  5. * Compile with the switch:  /n
  6.  
  7. * This code is released to public domain.
  8. *  (That means that somebody may want to clean up my variable naming usage!)
  9.  
  10. * For testing only:
  11. * Compile with the switch  /dTEST  and  this program will write out an exact
  12. *   duplicate of the input file.  You can use this to verify that program
  13. *   actually copies entire files, byte for byte !
  14. *   (See the CheckIt() function at the end of the program listing.)
  15.  
  16. FUNCTION libfix( file1, file2 )
  17.  
  18. // You may use this program to replace all occurrences
  19. //      of a series of characters with another series
  20. // Note both must be the same length (as this program is currently written)
  21.     old_str :=   "CLIPPER501"
  22.     new_str :=   "CLIPPER520"
  23.  
  24.     nLineFlag := PROCLINE() + 1
  25.     IF LEN(old_str) != LEN(new_str)
  26.         IF nLineFlag > 0
  27.             ?
  28.             ? "Programmer's ERROR:  In program line:  "
  29.             ?? LTRIM( STR( nLineFlag,10,0) )
  30.         ENDIF
  31.         error_msg(" Old and new strings must be the same length. ")
  32.         ERRORLEVEL(254)
  33.         QUIT
  34.     ENDIF
  35.  
  36.     SETCOLOR("W+/B","N/BG")
  37.  
  38.     CLEAR
  39.  
  40.     @ 2,0 to 6,79
  41.     @ 3,1 SAY PADC("Program to replace all occurrences",78)
  42.     @ 4,1 SAY PADC("  of:  " + old_str, 78)
  43.     @ 5,1 SAY PADC("with:  " + new_str, 78)
  44.  
  45.     IF PCOUNT() > 0 ;
  46.         .AND. UPPER(LTRIM(RTRIM( file1 ))) $ "?~/?~-?~H~/H~-H~HELP~/HELP~-HELP"
  47.  
  48. ?
  49. ? "  …ÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕª "
  50. ? "  ∫   This program can be used to replace all occurrences of one series      ∫ "
  51. ? "  ∫   of characters or bytes with the contents of another series.            ∫ "
  52. ? "  ∫                                                                          ∫ "
  53. ? "  ∫   This program is currently compiled to solve a problem with upgrading   ∫ "
  54. ? "  ∫   third party libraries from Clipper 5.01 to Clipper 5.2.                ∫ "
  55. ? "  ∫                                                                          ∫ "
  56. ? "  ∫   The symbol CLIPPER501 in many libraries needs to be changed to         ∫ "
  57. ? "  ∫   CLIPPER520.  This can be accomplished using this program instead of    ∫ "
  58. ? "  ∫   recompiling all of the libraries.                                      ∫ "
  59. ? "  ∫                                                                          ∫ "
  60. ? "  ∫   I suggest first rename the old library with an extension of:  *.L50    ∫ "
  61. ? "  ∫   The program will prompt for the file names for input and output.       ∫ "
  62. ? "  ∫                                                                          ∫ "
  63. ? "  ∫   File names may also be entered on the command line as:                 ∫ "
  64. ? "  ∫       LIBFIX  <Input file>  <Output file>                                ∫ "
  65. ? "  ∫   Example:                                                               ∫ "
  66. ? "  ∫       LIBFIX  NANFOR.L50  NANFOR.LIB                                     ∫ "
  67. ? "  »ÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕº "
  68.         WAIT
  69.         ERRORLEVEL(1)
  70.         QUIT
  71.     ENDIF
  72.  
  73.     IF PCOUNT() > 0 .AND. file( file1 )
  74.         f_in := UPPER(file1)
  75.         @ 8,1 SAY " File to convert: " + f_in
  76.  
  77.     ELSE
  78.         f_in := space(13)
  79.         @ 8,10 SAY " Enter file to convert: " GET f_in picture "@!"
  80.         SET CONFIRM ON
  81.         READ
  82.     ENDIF
  83.  
  84.     f_in := TRIM(f_in)
  85.  
  86.     IF LEN(f_in) == 0
  87.         ERRORLEVEL(1)
  88.         QUIT
  89.     ENDIF
  90.  
  91.     IF .NOT. file( f_in )
  92.         error_msg("FILE NOT FOUND: " + f_in)
  93.         ERRORLEVEL(1)
  94.         QUIT
  95.     ENDIF
  96.  
  97.     IF PCOUNT() > 1
  98.         f_out := UPPER(file2)
  99.         @ 10,1 SAY "Output file name: " + f_out
  100.  
  101.     ELSE
  102.         f_out := space(13)
  103.         @ 10,10 SAY "Enter output file name: " GET f_out picture "@!"
  104.         SET CONFIRM ON
  105.         READ
  106.     ENDIF
  107.  
  108.     f_out := TRIM(f_out)
  109.     IF LEN(f_out) == 0
  110.         ERRORLEVEL(1)
  111.         QUIT
  112.     ENDIF
  113.  
  114.     IF f_in == f_out
  115.         error_msg( "DUPLICATE FILE NAME ERROR" )
  116.         ERRORLEVEL(1)
  117.         QUIT
  118.     ENDIF
  119.  
  120.     IF FILE( f_out )
  121.         DEVPOS(11,0)
  122.         x_color := SETCOLOR("W+/R")
  123.  
  124.         ? CHR(7)
  125.         ? " File already exists:  " + f_out
  126.         ?
  127.         SETCOLOR(x_color)
  128.         ? CHR(7)
  129.         l_kill := .F.
  130.         n_row := row()
  131.         @ n_row, 2 SAY "OK to overwrite? " GET l_kill picture "Y"
  132.         SET CONFIRM OFF
  133.         READ
  134.         IF .NOT. l_kill
  135.             ERRORLEVEL(1)
  136.             QUIT
  137.         ENDIF
  138.         @ n_row - 2 ,0 CLEAR TO n_row+1, 79
  139.     ENDIF
  140.  
  141.     fh_in := FOPEN( f_in )
  142.     IF fh_in < 0
  143.         error_msg("UNABLE TO OPEN FILE: " + f_in)
  144.         ERRORLEVEL(1)
  145.         QUIT
  146.     ENDIF
  147.  
  148.  
  149.     fh_out := FCREATE( f_out )
  150.     IF fh_out < 0
  151.         error_msg( "UNABLE TO CREATE OUTPUT FILE: " + f_out)
  152.         FCLOSE(fh_in)
  153.         ERRORLEVEL(1)
  154.         QUIT
  155.     ENDIF
  156.  
  157.  
  158.     cStr := SUBSTR(old_str,1)
  159.     cStrLen := LEN(cStr)
  160.  
  161.     c1 := space(1)
  162.  
  163.     FSEEK( fh_in , 0 )  // position to beginning of input file
  164.  
  165.     bytes_in := 0
  166.  
  167.     bytes_in := FREAD( fh_in, @cStr, cStrLen )
  168.     IF bytes_in < cStrLen
  169.         FCLOSE(fh_in)
  170.         FCLOSE(fh_out)
  171.         FERASE(f_out)
  172.         error_msg("FILE TOO SMALL, COULD NOT CONTAIN DESIRED DATA: " + f_in)
  173.         ERRORLEVEL(1)
  174.         QUIT
  175.     ENDIF
  176.  
  177.     bytes_out := 0
  178.  
  179.     nShow := 0
  180.  
  181.     DEVPOS(12,0)
  182.     ?
  183.  
  184.     while bytes_in > 0
  185.  
  186.         // Read next character and temporarily hold it in c1:
  187.         bytes_in := FREAD( fh_in, @c1, 1 )
  188.         IF bytes_in < 1
  189.             // Write out the rest of the buffer:
  190.             bytes_out := FWRITE( fh_out, cStr, cStrLen)
  191.             IF bytes_out < cStrLen
  192.                 error_out()
  193.                 WAIT
  194.             ELSE
  195.                 ?
  196.                 ? PADC(" DONE ",80, CHR(205))
  197.                 ?
  198.             ENDIF
  199.             EXIT
  200.         ENDIF
  201.  
  202.         // Write out oldest character:
  203.         bytes_out := FWRITE( fh_out, LEFT(cStr,1), 1)
  204.         IF bytes_out <> 1
  205.             FCLOSE(fh_in)
  206.             FCLOSE(fh_out)
  207.             error_out()
  208.             WAIT
  209.             ERRORLEVEL(1)
  210.             QUIT
  211.         ENDIF
  212.  
  213.         // Shift buffer and add the next character that was read above:
  214.         cStr := SUBSTR( cStr, 2, cStrLen-1) + c1
  215.  
  216.         // Check for character series that needs to be subsituted:
  217.         Check_It()
  218.  
  219.         nShow ++
  220.         IF nShow > 63
  221.             // Show activity only every 64th byte:
  222.             nShow := 0
  223.             ?? "."
  224.             IF inkey() == 27    // Escape key pressed
  225.                 FCLOSE(fh_in)
  226.                 FCLOSE(fh_out)
  227.                 x_color := SETCOLOR("W+/R")
  228.                 ? chr(7)
  229.                 ? PADC("ESCAPE was pressed.   Program terminated.",80)
  230.                 ? PADC("File will be truncated (may not be complete).",80)
  231.                 ? chr(7)
  232.                 SETCOLOR( x_color)
  233.  
  234.                 quit
  235.             ENDIF
  236.         ENDIF
  237.  
  238.     enddo
  239.  
  240.  
  241.     FCLOSE(fh_in)
  242.     FCLOSE(fh_out)
  243.  
  244. RETURN (NIL)
  245.  
  246. ******************************
  247. ******************************
  248.  
  249. FUNCTION error_out()
  250.  
  251.     local x_color := SETCOLOR("W+/R")
  252.  
  253.     ?
  254.     ? "          Error writing output file.           "
  255.     ? chr(7)
  256.     ? " File will be truncated (may not be complete). "
  257.     ? chr(7)
  258.  
  259.     SETCOLOR( x_color)
  260.  
  261.     RETURN (NIL)
  262.  
  263. ***************************
  264.  
  265. FUNCTION error_msg( c_msg )
  266.  
  267.     local x_color := SETCOLOR("W+/R")
  268.  
  269.     ? chr(7)
  270.     ? space(1)
  271.     ?? c_msg
  272.     ?? space(1)
  273.     ? chr(7)
  274.  
  275.     SETCOLOR( x_color)
  276.  
  277.     WAIT
  278.  
  279.     RETURN (NIL)
  280.  
  281. ***************************
  282.  
  283. FUNCTION Check_It()
  284.  
  285.     STATIC nCount := 0
  286.  
  287.     IF cStr == old_str
  288.  
  289. // Skip the substitution if TEST is defined.  This may be useful if you want
  290. //   to verify that this program actually copies correctly byte for byte !
  291. #ifndef TEST
  292.         // Make the substitution:
  293.         cStr := new_str
  294. #endif
  295.         nCount ++
  296.         ? nCount
  297.         ?? ":  "
  298.         ?? old_str
  299.         ?? " --> "
  300.         ?? new_str
  301.         ?? "  "
  302.         ?
  303.     ENDIF
  304.  
  305.     RETURN (NIL)
  306.  
  307. ***************************
  308.  
  309.